
open Ast

type strval =
	| SVString of string
	| SVNumeric of float
	| SVBoolean of bool

and js_function = bool * (string list) * (sourceElement list)

and js_value =
	| VUndefined
	| VNull
	| VBool of bool
	| VString of string
	| VNumber of float
	| VMemory of int
	| VUnknown
	| VUnknownButTrue
	| VUnknownButFalse
	

module StrMap = Map.Make(String)
module StrSet = Set.Make(String)


type js_memory =
	| MObject of (js_value StrMap.t) * (js_function StrMap.t) * (js_function StrMap.t) * bool
	| MArray of (js_value StrMap.t) * bool
	| MFunction of bool * (string list) * (sourceElement list) * (js_value StrMap.t) * bool
	| MUnknown

and js_var = 
	| VarConst of js_value
	| VarVar of js_value
	
and flowbreak = {
	returns : js_value list;
	returnsAlways : bool;
	throws : bool;
	breaks : string list;
	anonymousBreak : bool;
}

and context = {
	co_context : int;
	co_current : int option;
	co_nesting : int
}

and refvalue = {
	ref_value : js_value;
	ref_index : int option
}

let lst_to_map lst = let rec inside_lst_to_map i = function
	| [] -> StrMap.empty
	| a::b -> let map = inside_lst_to_map (i+1) b in
		StrMap.add (string_of_int i) a map
	in
	inside_lst_to_map 0 lst
	
let effectable_variables = ref StrSet.empty

let effectable_set set =
	(let s = !effectable_variables in
	effectable_variables := set;
	s)


let memory = ref ((Hashtbl.create 100),0)

let rec memory_reset mem =
	let mem2 = !memory in
	memory := mem; mem2

and memory_reinstall () = 
	let memory = memory_reset ((Hashtbl.create 100),0) in
	let _ = create_env () in
	memory

and memory_push value = 
	let mem,index = !memory in
	Hashtbl.add mem index value;
	memory := (mem,index +1);
	index
	
and memory_has index = 
	let memory, _ = !memory in
	Hashtbl.mem memory index

and memory_set index value =
	let memory,_ = !memory in
	Hashtbl.add memory index value

and memory_get index =
	let memory,_ = !memory in
	if Hashtbl.mem memory index then Hashtbl.find memory index else MUnknown
	
and create_function is_inline params body exact =
	let index = memory_push (MObject(StrMap.empty,StrMap.empty,StrMap.empty,true)) in
	let map = StrMap.add "constructor" (VMemory 2) StrMap.empty in
	let map = StrMap.add "prototype" (VMemory index) map in
	memory_push (MFunction(is_inline,params,body,map,exact))

and create_array lst =
	let map = lst_to_map lst in
	let map = StrMap.add "constructor" (VMemory 3) map in
	memory_push (MArray(map,true))

and create_object both getter setter =
	let both = StrMap.add "constructor" (VMemory 1) both in
	memory_push (MObject(both,getter,setter,true))
		
	
and create_env () = 
	let _ = memory_push (MObject((
			(StrMap.add "Array" (VMemory 3)
			(StrMap.add "Function" (VMemory 2)
			(StrMap.add "Object" (VMemory 1)
			(StrMap.add "window" (VMemory 0) StrMap.empty))))),StrMap.empty,StrMap.empty,false)) in
	let _ = create_function false [] [] false in
	let _ = create_function false [] [] false in
	let _ = create_function false [] [] false in
	StrMap.add "window" (VarVar(VMemory(0))) StrMap.empty
	
let is_int x =
		(float_of_int (int_of_float x)) = x
	
let string_of_flint numeric = 
		if is_int numeric then string_of_int (int_of_float numeric) 
		else string_of_float numeric


let rec memory_get_value eval_func variables isCertain context expr =
	let rec sub_get_constructor variables context both expr =
		let exprValue = StrMap.find "constructor" both in
		(match exprValue with
			| VMemory index -> 
				(match memory_get index with
					| MFunction(_,_,_,map,_) -> let exprValue = StrMap.find "prototype" map in
						(match exprValue with
							| VMemory index -> let value, sideEffects, variables = sub_get_value variables context (Some (VMemory index)) expr in
								value, context, sideEffects, variables
							| _ -> VUnknown, context, [], variables
						)
					| _ -> VUnknown, context, [], variables
				)
			| _ -> VUnknown, context, [], variables
		)

	and sub_get_value variables context target expr1 =
		let value, context, sideEffects, variables = (match target with
				| None -> (match expr1 with
					| VString ident -> 
						if ident = "this" then
							(match context.co_current with
								| None -> VUnknown
								| Some index -> VMemory(index)), context, [], variables
						else if StrMap.mem ident variables then
						(match (StrMap.find ident variables) with 
							| VarVar content | VarConst content -> content, context, [], variables
						) else
						(match (memory_get 0) with
							| MObject(both,getter,setter,_) ->
								if StrMap.mem ident getter then
									let _, params, body = StrMap.find ident getter in
									let exprValue, sideEffects = eval_func variables isCertain {
										co_context = 0;
										co_current = (Some 0);
										co_nesting = context.co_nesting
										} params body [] in
									exprValue, context, sideEffects, variables
								else if StrMap.mem ident both then
									(StrMap.find ident both), context, [], variables
								else
									VUnknown, context, [], variables
							| _ -> VUnknown, context, [], variables (* Should never happen *)
						)
					| _ -> VUnknown, context, [], variables)
				| Some target -> (match target with
					| VMemory index -> 
						(match (memory_get index) with
						| MObject (both,getter,setter,exact) -> (match expr1 with
							| VNumber pos -> 
								let str_num = string_of_flint pos in
								(if StrMap.mem str_num getter then
									let _, params,body = StrMap.find str_num getter in
									let exprValue, sideEffects = eval_func variables isCertain {
										co_context = context.co_context;
										co_current = Some index;
										co_nesting = context.co_nesting
										} params body [] in
										exprValue, context, sideEffects, variables
								else if StrMap.mem str_num both then
									(StrMap.find str_num both), context, [], variables
								else if exact && StrMap.mem "constructor" both then
									sub_get_constructor variables context both expr1
								else
									(if exact then VUndefined else VUnknown), context, [], variables
								)
							| VString ident ->
								if StrMap.mem ident getter then
									let _, params, body = StrMap.find ident getter in
									let exprValue, sideEffects = eval_func variables isCertain {
										co_context = context.co_context;
										co_current = Some index;
										co_nesting = context.co_nesting
										} params body [] in
										exprValue, context, sideEffects, variables
								else if StrMap.mem ident both then
									(StrMap.find ident both), context, [], variables
								else if exact && StrMap.mem "constructor" both then
									sub_get_constructor variables context both expr1
								else
									(if exact then VUndefined else VUnknown), context, [], variables (* Could be Undefined if Object has no inner method or property *)
							| VBool boolean -> 
								let str_bool = string_of_bool boolean in
								(if StrMap.mem str_bool getter then
									let _, params,body = StrMap.find str_bool getter in
									let exprValue, sideEffects = eval_func variables isCertain {
										co_context = context.co_context;
										co_current = Some index;
										co_nesting = context.co_nesting
										} params body [] in
										exprValue, context, sideEffects, variables
								else if StrMap.mem str_bool both then
									(StrMap.find str_bool both), context, [], variables
								else if exact && StrMap.mem "constructor" both then
									sub_get_constructor variables context both expr1
								else
									(if exact then VUndefined else VUnknown), context, [], variables
								)
							| _ -> VUnknown, context, [], variables)
						| MArray(map,exact) -> (match expr1 with
							| VNumber pos -> 
								let str_num = string_of_flint pos in
								(if StrMap.mem str_num map then
									(StrMap.find str_num map), context, [], variables
								else if exact && StrMap.mem "constructor" map then
									sub_get_constructor variables context map expr1
								else
									(if exact then VUndefined else VUnknown), context, [], variables
								)
							| VString ident ->
								if StrMap.mem ident map then
									(StrMap.find ident map), context, [], variables
								else if exact && StrMap.mem "constructor" map then
									sub_get_constructor variables context map expr1
								else (if exact then VUndefined else VUnknown), context, [], variables
							| VBool value ->
								let str_bool = string_of_bool value in
								(if StrMap.mem str_bool map then
									(StrMap.find str_bool map), context, [], variables
								else if exact && StrMap.mem "constructor" map then
									sub_get_constructor variables context map expr1
								else (if exact then VUndefined else VUnknown), context, [], variables
								)
							| _ -> VUnknown, context, [], variables)
						| MFunction(_,_,_,map,exact) -> (match expr1 with
							| VNumber pos -> 
								let str_num = string_of_flint pos in
								(if StrMap.mem str_num map then
									(StrMap.find str_num map), context, [], variables
								else if exact && StrMap.mem "constructor" map then
									sub_get_constructor variables context map expr1
								else (if exact then VUndefined else VUnknown), context, [], variables
								)
							| VString ident ->
								if StrMap.mem ident map then
									(StrMap.find ident map), context, [], variables
								else if exact && StrMap.mem "constructor" map then
									sub_get_constructor variables context map expr1
								else (if exact then VUndefined else VUnknown), context, [], variables
							| VBool value ->
								let str_bool = string_of_bool value in
								(
									if StrMap.mem str_bool map then
										(StrMap.find str_bool map), context, [], variables
									else if exact && StrMap.mem "constructor" map then
									sub_get_constructor variables context map expr1
									else (if exact then VUndefined else VUnknown), context, [], variables
								)
							| _ -> VUnknown, context, [], variables)
						| MUnknown -> VUnknown, context, [], variables
						)
					| _ -> VUnknown, context, [], variables)) in
				value, sideEffects, variables
	in sub_get_value variables context (match context.co_current with
		| None -> None
		| Some index -> Some (VMemory index)) expr
		
let willMaybeReturn return =
	{
		returns = return.returns;
		returnsAlways = false;
		throws = false;
		breaks = [];
		anonymousBreak = false;
	}
		
let defaultReturn = {
	returns = [];
	returnsAlways = false;
	throws = false;
	breaks = [];
	anonymousBreak = false;
}

let defaultRefValue = {
	ref_index = None;
	ref_value = VUnknown
}

let rec list_fill_right x value lst =
	if x = 0 then lst
	else (list_fill_right (x-1) value lst)@[value]

let rec list_sub x lst =
	let x = if x < 0 then (List.length lst) + x else x in
	if x = 0 then [] 
	else match lst with
		| [] -> [] (* Should throw error *)
		| a::lst -> a::(list_sub (x-1) lst)
		
let rec list_intersect = function
	| [] -> []
	| [lst] -> lst
	| lst1::lst -> let lst2 = list_intersect lst in
		List.filter (fun x -> List.mem x lst2) lst1

let rec list_set x value = function
	| [] -> []
	| a::lst ->
		if x == 0 then
			value::lst
		else
			a::(list_set (x-1) value lst)

let rec strlist_fill_right x value map =
		let rec inside_strlist_fill_right i value map =
			if i == x then map else 
			let str_i = string_of_int i in
			let map = (if StrMap.mem str_i map then map else StrMap.add str_i value map) in
			inside_strlist_fill_right (i+1) value map in
		inside_strlist_fill_right 0 value map
		
let rec memory_set_value eval_func variables isCertain context value expr = 

	(*let sub_erase index = 
		let value = memory_get index in
			(match value with
				| MObject(_,getters,setters,_) -> memory_set index (MObject (StrMap.empty, getters, setters,false))
				| MArray(_,_) -> memory_set index (MArray (StrMap.empty,false))
				| MFunction(is_inline,params,body,_,_) -> memory_set index (MFunction (is_inline,params,body,StrMap.empty,false))
			)
	in *)

	
	(match context.co_current with
		| None -> 
			(match expr with
				| VString ident -> if ident = "this" then
					[], variables
					else if StrMap.mem ident variables then
						(match StrMap.find ident variables with
							| VarConst _ -> [], variables (* Should throw error *)
							| VarVar content -> 
								[], (StrMap.add ident (VarVar value) variables))
					else 
						(match (memory_get 0) with
							| MObject(both,getter,setter,exact) ->
								if StrMap.mem ident setter then
									let _, params, body = StrMap.find ident setter in
									let _, sideEffects = eval_func variables isCertain {
										co_context = 0;
										co_current = (Some 0);
										co_nesting = context.co_nesting
										} params body [value] in
									sideEffects, variables
								else
									(memory_set 0 (MObject( (StrMap.add ident value both), getter, setter,exact));
									[], variables)
							| _ -> [], variables
						)
				| VUnknown -> let _ = memory_reinstall () in
					let variables = StrMap.fold (fun key value map -> match value with
						| VarConst _ -> StrMap.add key value map
						| VarVar v -> StrMap.add key (VarVar (if StrSet.mem key !effectable_variables then VUnknown else v)) map) variables StrMap.empty in
						[], variables
				| _ -> [], variables ) (* Should never happen *)
		| Some index ->
			let left = memory_get index in
			(match left with
				| MObject(both,getter,setter,exact) ->
					(match expr with
						| VString ident -> 
							if StrMap.mem ident setter then
								let _, params, body = StrMap.find ident setter in
								let _, sideEffects = eval_func variables isCertain {
									co_context = context.co_context;
									co_current = Some index;
									co_nesting = context.co_nesting
									} params body [value] in
									sideEffects, variables
							else
								(memory_set index (MObject ((StrMap.add ident value both), getter,setter,exact));
								[], variables)
								
						| VNumber numeric ->
							let str_num = string_of_flint numeric in
							(if StrMap.mem str_num setter then
								let _, params, body = StrMap.find str_num setter in
								let _, sideEffects = eval_func variables isCertain {
									co_context = context.co_context;
									co_current = Some index;
									co_nesting = context.co_nesting
									} params body [value] in
									sideEffects, variables
							else
								(memory_set index (MObject ((StrMap.add str_num value both), getter,setter,exact));
								[], variables)
							)
						| VBool boolean -> 
							let str_bool = string_of_bool boolean in
							(if StrMap.mem str_bool setter then
								let _, params, body = StrMap.find str_bool setter in
								let _, sideEffects = eval_func variables isCertain {
									co_context = context.co_context;
									co_current = Some index;
									co_nesting = context.co_nesting
									} params body [value] in
									sideEffects, variables
							else
								(memory_set index (MObject ((StrMap.add str_bool value both), getter,setter,exact));
								[], variables)
							)
						| _ -> let _ = memory_reinstall () in 
							let variables = StrMap.fold (fun key value map -> match value with
							| VarConst _ -> StrMap.add key value map
							| VarVar v -> StrMap.add key (VarVar (if StrSet.mem key !effectable_variables then VUnknown else v)) map) variables StrMap.empty in
							(*sub_erase index; *) [], variables
					)
				| MArray(map,exact) -> 
					(match expr with
						| VString ident -> 
							if StrMap.mem ident map then
								(memory_set index (MArray ((StrMap.add ident value map), exact));
								[], variables)
							else
								[], variables
						| VNumber numeric ->
							let str_num = string_of_flint numeric in
							(let map = (
								if is_int numeric then
									(let pos = int_of_float numeric in
										strlist_fill_right pos (if exact then VUndefined else VUnknown) map)
								else
									map)
							in
								if StrMap.mem str_num map then
									(memory_set index (MArray ((StrMap.add str_num value map),exact)));
								[], variables
							)
						| VBool boolean -> 
							let str_bool = string_of_bool boolean in
							if StrMap.mem str_bool map then
								(memory_set index (MArray ((StrMap.add str_bool value map), exact)));
								[], variables
						| _ -> let _ = memory_reinstall () in 
							let variables = StrMap.fold (fun key value map -> match value with
								| VarConst _ -> StrMap.add key value map
								| VarVar v -> StrMap.add key (VarVar (if StrSet.mem key !effectable_variables then VUnknown else v)) map) variables StrMap.empty in
								[], variables
					)
				| MFunction(is_inline,params,body,map,exact) -> 
					(match expr with
						| VString ident -> 
							(if StrMap.mem ident map then
								memory_set index (MFunction (is_inline,params,body, (StrMap.add ident value map), exact));
								[], variables)
						| VNumber numeric ->
							let str_num = string_of_flint numeric in
							(if StrMap.mem str_num map then
								memory_set index (MFunction (is_inline,params,body, (StrMap.add str_num value map), exact));
								[], variables)
						| VBool boolean -> 
							let str_bool = string_of_bool boolean in
							(if StrMap.mem str_bool map then
								memory_set index (MFunction (is_inline,params,body, (StrMap.add str_bool value map), exact));
								[], variables)
						| _ -> let _ = memory_reinstall () in 
								let variables = StrMap.fold (fun key value map -> match value with
									| VarConst _ -> StrMap.add key value map
									| VarVar v -> StrMap.add key (VarVar (if StrSet.mem key !effectable_variables then VUnknown else v)) map) variables StrMap.empty in
									[], variables
					)
				| MUnknown -> [], variables
				)
			)
	
	
let jsArray_to_list map = 
	let rec sub_jsArray_to_list index =
		if StrMap.mem (string_of_int index) map then
			let lst = sub_jsArray_to_list (index+1) in
			(StrMap.find (string_of_int index) map)::lst
		else []
	in
	(sub_jsArray_to_list 0)
	
let merge_types exprValue1 exprValue2 =
	match exprValue1 with
		| VBool false ->
			(match exprValue2 with
				| VBool false -> VBool(false)
				| VString "" | VNumber 0. | VUndefined | VNull | VUnknownButFalse -> VUnknownButFalse
				| _ -> VUnknown
			)
		| VBool true ->
			(match exprValue2 with
				| VBool true -> VBool(true)
				| VString "" | VNumber 0. | VBool false | VUndefined | VNull | VUnknownButFalse | VUnknown -> VUnknown
				| _ -> VUnknownButTrue
			)

		| VNumber 0. ->
			(match exprValue2 with
				| VNumber 0. -> VNumber(0.)
				| VString "" | VBool false | VUndefined | VNull | VUnknownButFalse -> VUnknownButFalse
				| _ -> VUnknown
			)
			
		| VNumber a ->
			(match exprValue2 with
				| VNumber 0. | VString "" | VBool false | VUndefined | VNull | VUnknownButFalse | VUnknown -> VUnknown
				| VNumber b -> if a = b then VNumber a else VUnknownButTrue
				| _ -> VUnknownButTrue
			)

		| VUndefined ->
			(match exprValue2 with
				| VUndefined -> VUndefined
				|  VString "" | VBool false | VNumber 0. | VNull | VUnknownButFalse -> VUnknownButFalse
				| _ -> VUnknown
			)

		| VNull ->
			(match exprValue2 with
				| VNull -> VNull
				|  VString "" | VBool false | VNumber 0. | VUndefined | VUnknownButFalse -> VUnknownButFalse
				| _ -> VUnknown
			)

		| VString "" ->
			(match exprValue2 with
				| VString "" -> VString("")
				| VBool false | VNumber 0. | VUndefined | VNull | VUnknownButFalse -> VUnknownButFalse
				| _ -> VUnknown
			)
		| VString a ->
			(match exprValue2 with
				| VString "" | VNumber 0. | VUndefined | VNull | VUnknownButFalse | VUnknown -> VUnknown
				| VString b -> if a = b then VString a else VUnknownButTrue
				| _ -> VUnknownButTrue
			)
			
		| VUnknownButTrue ->
			(match exprValue2 with
				| VString "" | VNumber 0. | VUndefined | VNull | VUnknownButFalse | VBool false | VUnknown -> VUnknown
				| _ -> VUnknownButTrue
			)

		| VMemory index1 ->
			(match exprValue2 with
				| VMemory index2 -> if index1 = index2 then VUnknown else VMemory(index1)
				| VString "" | VNumber 0. | VUndefined | VNull | VUnknownButFalse | VBool false | VUnknown -> VUnknown
				| _ -> VUnknownButTrue
			)
			
		| VUnknownButFalse ->
			(match exprValue2 with
				| VString "" | VNumber 0. | VUndefined | VNull | VUnknownButFalse | VBool false -> VUnknownButFalse
				| _ -> VUnknown
			)
		| VUnknown -> VUnknown 

let rec memory_erase_sideEffects func variables isCertain context = function
	| [] -> variables
	| (a,_)::c -> let _, variables = memory_set_value func variables isCertain context VUnknown a.ref_value in
		memory_erase_sideEffects func variables isCertain context c

let rec merge_types_list = function
	| [] -> VUnknown
	| [a] -> a
	| a::b -> merge_types a (merge_types_list b)

let rec print_variables variables =
	print_string "Variables :\n";
	StrMap.fold (fun ident value _ -> 
		let value = match value with | VarVar content | VarConst content -> content in
		print_string ("\t" ^ ident ^ " = " ^ (print_value value) ^ "\n")) variables ()
		
and print_value = function
	| VUndefined -> "VUndefined"
	| VNull -> "VNull"
	| VBool b -> "VBool (" ^ (if b then "true" else "false") ^ ")"
	| VString s -> "VString (" ^ s ^ ")"
	| VNumber v -> "VNumber (" ^ (string_of_flint v) ^ ")"
	| VMemory v -> "VMemory (" ^ (string_of_int v) ^ ")"
	| VUnknown -> "VUnknown"
	| VUnknownButTrue -> "VUnknownButTrue"
	| VUnknownButFalse -> "VUnknownButFalse"

and print_memory () =
	let memory,_ = !memory in
	(print_string "Memory :\n";
	Hashtbl.iter (fun i v -> print_string ("\tVMemory(" ^ (string_of_int i) ^ ") : ");
	(match v with
		| MObject (map,_,_,_) -> print_mobject map;
		| MArray _ -> print_string "\n"
		| MFunction _ -> print_string "\n"
		| _ -> print_string "\n"
	);
	) memory)

and print_mobject map =
	print_string "Mobject (\n";
	StrMap.iter (fun a b -> print_string ("\t" ^ a ^ " : " ^ (print_value b) ^ "\n")) map;
	print_string ")\n"
	
